Internet Info 1994 March/Internet Info CD-ROM (Walnut Creek) (March 1994).iso/networking/terms/kermit/c/pq2rea.pas

Pascal/Delphi Source File | 1988-08-16 | 17.5 KB | 570 lines

Module KermitRead;

{ This module exports routines for receiving files from a remote machine }

{========================} exports {=========================================}

imports KermitFile from KermitFile;
imports KermitGlobals from KermitGlobals;

function   ReadSwitch : KermitStates;

function   ReceiveInit( VAR RFile   : FNameType ) : KermitStates;

{========================} private {=========================================}

const
    SenderAborted = 'Transfer was aborted by sender error packet';

imports KermitParameters from KermitParameters;
imports KermitLineIO from KermitLineIO;
imports System from System;
imports UtilProgress from UtilProgress;

VAR Mess : String;  { Last file error message }

{----------------------------------------------------------------------------}

function   ReceiveInit( VAR RFile   : FNameType ) : KermitStates;
{  Prod the server to make it send us a file }
VAR Pack : Packet;
begin
    PutFileName( RFile, Pack );
    SendPacket( RinitPack, 0, -1, Pack );
    ReceiveInit := Init;
end;

{----------------------------------------------------------------------------}

function    ReadData : KermitStates;
const
    DataExp = '?Illegal packet type received - expected data packet';

var     Len, Num, Dummy     : integer;
        RetVal              : KermitStates;
        Pack                : Packet;
        ErrCode             : FileErrs;

    handler CtlC;
    begin
        CtrlCPending := false;
        ReadData := AbortCtlC;
        exit( ReadData );
    end;

begin
    if Debug then begin
        DbgWrite( ' Entering ReadData ..... ' );
        DbgNL;
    end;
    NumTry := NumTry + 1;
    if NumTry>1 then
        TotTry := TotTry + 1;
    if NumTry > MaxTryPack then begin
        Mess := '?Unable to receive data';
        writeln( Mess );
        RetVal := Abort1;
    end
    else
    begin
        case ReadPacket ( Num , Len , Pack ) of

            DataPack :
                begin
                    if Num <> n then
                    begin
                        OldTry := OldTry + 1;
                        if OldTry > MaxTryPack then begin
                            Mess := '?Unable to acknowledge data packet';
                            writeln( Mess );
                            SendErrPack( Mess );
                            RetVal := AbortAll;
                        end
                        else
                        begin
                            if  Num = Prev ( n ) then
                            begin
                                SendAck( Num );
                                NumTry := 0;
                                RetVal := CurrState;
                            end
                            else begin
                                Mess := '?Data packet out of sequence';
                                writeln( Mess );
                                SendErrPack( Mess );
                                RetVal := AbortAll;
                            end;
                        end;
                    end
                    else
                    begin
                        ErrCode := EmptyBuffer ( Pack );
                        if ErrCode >=FNoError then begin
                            SendACK( n );
                            Succeeded;
                            RetVal := CurrState;
                        end else begin
                            FileError( '', ErrCode, Mess );
                            writeln( Mess );
                            RetVal := Abort1;
                        end
                    end;
                end;

            FHeadPack   :
                begin
                    OldTry := OldTry + 1;
                    if OldTry > MaxTryPack then begin
                        LocalError
                            ( '?Unable to acknowledge file header packet' );
                        RetVal := AbortAll;
                    end
                    else
                        if Num = Prev ( n ) then
                        begin
                            SendACK( num );
                            NumTry := 0;
                            RetVal := CurrState;
                        end
                        else begin
                            LocalError( DataExp );
                            RetVal := Abort1;
                        end;
                end;

            EOFPack     :
                begin
                    if Num <> n then begin
                        LocalError( '?EOF packet out of sequence' );
                        RetVal := Abort1;
                    end
                    else
                    begin
                        if (Len > 0) and (Pack.Data[1] = 'D') then
                            ErrCode := DiscardFile
                        else
                            ErrCode := KeepFile;
                        if ErrCode>=FNoError then begin
                            SendAck( n );
                            Succeeded;
                            RetVal := FileHeader;
                        end else begin
                            FileError( '', ErrCode, Mess );
                            SendErrPack( Mess );
                            writeln( Mess );
                            RetVal := AbortAll;
                        end;
                    end;
                end;

            ErrPack:
                begin
                    TreatErrPack( Pack, Num );
                    RetVal := AbortAll;
                end;

            NAKPack    :
                begin
                    SendNAK( n );
                    RetVal := CurrState;
                end;

            ACKPack, SInitPack,
            IllPack    :
                begin
                    writeln( DataExp );
                    RetVal := Abort1;
                end;

            ChkIllPack :
                begin
                    if Debug then begin
                        DbgWrite ( 'Illegal CheckSum  - Sending NAK' );
                        DbgNL;
                    end;
                    SendNAK ( n );
                    RetVal := CurrState;
                end;

            TimOutPack  :
                begin
                    if Debug then begin
                        DbgWrite ( 'Timed out waiting for pack. number:' );
                        DbgInt ( n );
                        DbgNL;
                    end;
                    SendAck ( Prev(n) );
                   { SendNAK ( n ); }
                    RetVal := CurrState;
                end;
        end;  { case }
    end;
    ReadData := RetVal;
end;

{----------------------------------------------------------------------------}

Const OnlyFile = False; TextReply = True;

function    ReadFile( ReplyExpected : Boolean ) : KermitStates;

const   FHeadExp =
            '?Illegal packet type received - expected file header packet';

var     num         : integer;
        len         : integer;
        Status      : integer;
        Pack        : Packet;
        RetVal      : KermitStates;
        FileName    : FNameType;
        FE          : FileErrs;

    handler CtlC;
    begin
        CtrlCPending := false;
        ReadFile := AbortCtlC;
        exit( ReadFile );
    end;

begin
    if Debug then begin
        DbgWrite( 'Entering ReadFile ...... ');
        DbgNL;
    end;
    NumTry := NumTry + 1;
    if NumTry>1 then
        TotTry := TotTry + 1;
    if NumTry > MaxTryPack then begin
        LocalError( '?Unable to receive file header' );
        RetVal := AbortAll;
    end
    else
    begin
        case ReadPacket ( Num , len , Pack ) of

            SInitPack   :   { May be our ACK lost }
                if ReplyExpected then begin
                    Mess := '?Illegal packet type received';
                    writeln( Mess );
                    SendErrPack( Mess );
                    RetVal := AbortAll;
                end else begin
                    OldTry := OldTry + 1;
                    if OldTry > MaxTryPack then begin
                        writeln
                          ( '?Unable to acknowledge send initiate packet');
                        RetVal := AbortAll; { abort on too many errors }
                    end
                    else
                    begin
                        if num = Prev ( n ) then
                        { Previous packet? }
                        begin
                            ReadPars ( Pack );       { yes - re-ACK }
                            SendPacket( NoChangePack,
                                        num,
                                        -1,
                                        Pack    );
                            NumTry := 0;
                            RetVal := CurrState;
                        end;
                    end;
                end;

            EOFPack   :
                if ReplyExpected then begin
                    writeln( '?Illegal packet type received' );
                    RetVal := Abort1;
                end else begin
                    OldTry := OldTry + 1;
                    if OldTry > MaxTryPack then begin
                        writeln( '?Unable to acknowledge EOF packet' );
                        RetVal := Abort1;
                    end
                    else
                    begin
                        if  num = Prev ( n )  then
                        begin
                            SendACK( num );
                            NumTry := 0;
                            RetVal := CurrState;
                        end
                        else begin
                            writeln( FHeadExp );
                            RetVal := Abort1;
                        end;
                    end;
                end;

            THeadPack   :
                begin
                    if num<> n then
                        RetVal := Abort1
                    else
                    begin
                        WriteScreen;
                        RetVal := FileData;
                    end;
                end;

            FHeadPack   :   { which is what we really want }
                begin
                    if  num <> n then
                        RetVal := Abort1
                    else
                    begin
                        GetFilename ( Filename, Pack );
                        FE := NextWriteFile( FileName );
                        repeat
                            case FE of

                            FNoError, FRenamed:
                                begin
                                    SendACK( n );
                                    if Debug then begin
                                        DbgWrite( 'Receiving : ' );
                                        DbgFilename( FileName );
                                        DbgNL;
                                    end;
                                    Succeeded;
                                    RetVal := FileData;
                                    FE := FNoError;
                                end;

                            otherwise:      { Retry - error closing prev. file }
                                begin
                                    FileError( '', FE, Mess );
                                    writeln( Mess );
                                    FE := NextWriteFile( FileName );
                                end;
                            end;
                        until FE=FNoError;
                    end;
                end;

            BrkPack :
                begin
                    if  num <> n then begin
                        writeln
                            ( '?Break packet received out of sequence' );
                        RetVal := Abort1;
                    end
                    else
                    begin
                        SendACK( n );
                        RetVal := Complete;
                    end;
                end;

            ErrPack:
                begin
                    TreatErrPack( Pack, Num );
                    writeln( SenderAborted );
                    RetVal := AbortAll;
                end;

            AckPack :
                if ReplyExpected then begin
                    if N <> Num then begin
                        RetVal := AbortAll;
                    end else begin
                        WriteScreen;
                        Pack.PType := PackToCh( DataPack );
                        FE := EmptyBuffer( Pack );
                        FE := FileIdle;
                        RetVal := Complete;
                    end;
                end else begin
                    RetVal := Abort1;
                    writeln( FHeadExp );
                end;

            DataPack, NAKPack,
            IllPack :
                begin
                    RetVal := Abort1;
                    writeln( FHeadExp );
                end;

            ChkIllPack :
                begin
                    if Debug then begin
                        DbgWrite('Wrong checksum - sending NAK');
                        DbgNL;
                    end;
                    SendNAK( n );
                    RetVal := CurrState;
                end;

            TimOutPack  :
                begin
                    if Debug then begin
                        DbgWrite('Timed out waiting for FHeadPacket');
                        DbgNL;
                    end;
                    SendNAK( n );
                    RetVal := CurrState;
                end;
        end;
    end;
    ReadFile := RetVal;
end;

{----------------------------------------------------------------------------}



function    ReadInit : KermitStates;

const   SInitExp =
           '?Illegal packet type received - expected send initiate packet';

var     num     : integer;
        len     : integer;
        Pack    : Packet;
        RetVal  : KermitStates;
        Answer  : PacketType;

    handler CtlC;
    begin
        CtrlCPending := false;
        ReadInit := AbortCtlC;
        exit( ReadInit );
    end;

begin
    if Debug then begin
        DbgWrite( 'Entering ReadInit ...... ');
        DbgNL;
    end;
    NumTry := NumTry + 1;
    if NumTry>1 then
        TotTry := TotTry + 1;
    if NumTry > MaxTryInit then begin
        LocalError( '?Unable to receive initiate' );
        RetVal := AbortAll;
    end
    else
    begin
        Answer := ReadPacket( Num, len, Pack );
        if Answer = SInitPack then
        begin
            ReadPars( Pack );
            SendPacket(     NoChangePack,
                            n,
                            -1,
                            Pack    );
            Succeeded;
            RetVal := FileHeader;
        end
        else
            if Answer = TimOutPack then begin
                if Debug then begin
                    DbgWrite('Timed out waiting for Send-init - Retrying');
                    DbgNL;
                end;
                SendNAK ( n );
                RetVal := CurrState;
            end else
                if Answer = ChkIllPack then begin
                    if Debug then begin
                        DbgWrite('Illegal checksum - retrying');
                        DbgNL;
                    end;
                    SendNAK ( n );
                    RetVal := CurrState;
                end else
                    if Answer = ErrPack then begin
                        TreatErrPack( Pack, Num );
                        writeln( SenderAborted );
                        RetVal := AbortAll;
                    end else begin
                        if Debug then begin
                            DbgWrite('Unable to receive send-init-packet');
                            DbgNL;
                            DbgPacket( Pack );
                        end;
                        writeln( SInitExp );
                        SendErrPack( SInitExp );
                        RetVal := AbortAll;
                    end;

    end;
    ReadInit := RetVal;
end;

{----------------------------------------------------------------------------}

function   ReadSwitch : KermitStates;

var Dummy : FileErrs;

    handler CtlCAbort;
    begin
        CtrlCPending := false;
    end;

{  This is the state table switcher for the receive file function }
begin
    if (CurrState <> RemoteReply) then
        CurrState := Init;
    n := 0;
    nn := 0;
    NumTry := 0;
    OldTry := 0;
    TotTry := 0;
    InitProgress;
    LoadBusy;       { From UtilProgress - load Busy bee }
    ShowPackNum;

    while (CurrState <> AbortAll) and (CurrState <> Complete)
      and (CurrState <> AbortCtlC) do
    begin
        ShowPackNum;
        case CurrState of

            FileData    :
                CurrState := ReadData;

            FileHeader  :
                CurrState := ReadFile( OnlyFile );

            RemoteReply :
                CurrState := ReadFile( TextReply );

            Init        :
                CurrState := ReadInit;

            EOFile, Break   :
                begin
                    LocalError
                        ('?Unexpected packet read - EOFile or Break');
                    CurrState := Abort1;
                end;

            Abort1     :
                begin
                    FileAbort;
                    CurrState := FileHeader;
                end;
        end;

        ShowProgress( ProgressLines );
        if Debug then begin
            DbgWrite ( 'ReadSwitch :  State transition to --> ' );
            DbgState ( CurrState );
            DbgNL;
        end;

    end;

    if CurrState = AbortCtlC then begin
        writeln( AbortedByCtlC );
        SendErrPack( AbortedByCtlC );
    end;

    ReadSwitch := CurrState;
    Dummy := FileIdle;
    QuitProgress;
end.